home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / chars.swg / 0001_Manipulating the VGA Font.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  2.2 KB  |  108 lines
  1. {
  2. DAVID DRZYZGA
  3.  
  4. > Is there any way to create or use your own fonts in
  5. > regular Text mode With Pascal?
  6.  
  7. Here's a demo of a routine originally posted by Bernie P and revised by me:
  8. }
  9.  
  10. Program UpsideDown;
  11. {-upsidedown and backwards Text aka redefining the Text mode font}
  12. Var
  13.   newCharset,
  14.   oldCharset : Array[0..255,1..16] of Byte;
  15.  
  16. Procedure getoldCharset;
  17. Var
  18.   b : Byte;
  19.   w : Word;
  20. begin
  21.   For b := 0 to 255 do
  22.   begin
  23.     w := b * 32;
  24.     Inline($FA);
  25.     PortW[$3C4] := $0402;
  26.     PortW[$3C4] := $0704;
  27.     PortW[$3CE] := $0204;
  28.     PortW[$3CE] := $0005;
  29.     PortW[$3CE] := $0006;
  30.     Move(Ptr($A000, w)^, oldCharset[b, 1], 16);
  31.     PortW[$3C4] := $0302;
  32.     PortW[$3C4] := $0304;
  33.     PortW[$3CE] := $0004;
  34.     PortW[$3CE] := $1005;
  35.     PortW[$3CE] := $0E06;
  36.     Inline($FB);
  37.   end;
  38. end;
  39.  
  40. Procedure restoreoldCharset;
  41. Var
  42.   b : Byte;
  43.   w : Word;
  44. begin
  45.   For b := 0 to 255 do
  46.   begin
  47.     w := b * 32;
  48.     Inline($FA);
  49.     PortW[$3C4] := $0402;
  50.     PortW[$3C4] := $0704;
  51.     PortW[$3CE] := $0204;
  52.     PortW[$3CE] := $0005;
  53.     PortW[$3CE] := $0006;
  54.     Move(oldCharset[b, 1], Ptr($A000, w)^, 16);
  55.     PortW[$3C4] := $0302;
  56.     PortW[$3C4] := $0304;
  57.     PortW[$3CE] := $0004;
  58.     PortW[$3CE] := $1005;
  59.     PortW[$3CE] := $0E06;
  60.     Inline($FB);
  61.   end;
  62. end;
  63.  
  64. Procedure setasciiChar(Charnum : Byte; Var data);
  65. Var
  66.   offset : Word;
  67. begin
  68.   offset := CharNum * 32;
  69.   Inline($FA);
  70.   PortW[$3C4] := $0402;
  71.   PortW[$3C4] := $0704;
  72.   PortW[$3CE] := $0204;
  73.   PortW[$3CE] := $0005;
  74.   PortW[$3CE] := $0006;
  75.   Move(data, Ptr($A000, offset)^, 16);
  76.   PortW[$3C4] := $0302;
  77.   PortW[$3C4] := $0304;
  78.   PortW[$3CE] := $0004;
  79.   PortW[$3CE] := $1005;
  80.   PortW[$3CE] := $0E06;
  81.   Inline($FB);
  82. end;
  83.  
  84. Procedure newWriteln(s : String);
  85.  {- Reverses order of Characters written}
  86. Var
  87.   b : Byte;
  88. begin
  89.   For b := length(s) downto 1 do
  90.     Write(s[b]);
  91.   Writeln;
  92. end;
  93.  
  94. Var
  95.   b, c : Byte;
  96.  
  97. begin
  98.   getoldCharset;
  99.   For b := 0 to 255 do
  100.     For c := 1 to 16 do
  101.       newCharset[b, c] := oldCharset[b, (17 - c)];
  102.   For b := 0 to 255 do
  103.     setasciiChar(b, newCharset[b, 1]);
  104.   newWriteln('Hello World!');
  105.   readln;
  106.   restoreoldCharset;
  107. end.
  108.